home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / gs24src.zip / FONT2C.PS < prev    next >
Text File  |  1992-03-05  |  16KB  |  528 lines
  1. %    Copyright (C) 1992 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % font2c.ps
  21. % Write out a Type 1 font as C code that can be linked with Ghostscript.
  22. % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  23. % switch in the command line.
  24.  
  25. % Define the maximum string length that will get by the compiler.
  26. % This must be approximately
  27. %    min(max line length, max string literal length) / 4 - 5.
  28.  
  29. /max_wcs 50 def
  30.  
  31. % ------ Protection utilities ------ %
  32.  
  33. % Protection values are represented by a mask:
  34. /a_noaccess 0 def
  35. /a_executeonly 1 def
  36. /a_readonly 3 def
  37. /a_all 7 def
  38. /prot_names
  39.  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  40.  ] def
  41. /prot_opers
  42.  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  43.  ] def
  44.  
  45. % Get the protection of an object.
  46.    /getpa
  47.     { dup wcheck
  48.        { pop a_all }
  49.        {    % Check for executeonly or noaccess objects in protected.
  50.          dup protected exch known
  51.       { protected exch get }
  52.       { pop a_readonly }
  53.      ifelse
  54.        }
  55.       ifelse
  56.     } bind def
  57.  
  58. % Get the protection appropriate for (all the) values in a dictionary.
  59.    /getva        % get value protection attributes for dictionary
  60.     { a_noaccess exch
  61.        { exch pop
  62.          dup type dup /stringtype eq exch /arraytype eq or
  63.       { getpa or }
  64.       { pop pop a_all exit }
  65.      ifelse
  66.        }
  67.       forall
  68.     } bind def
  69.  
  70. % Keep track of executeonly and noaccess objects,
  71. % but don't let the protection actually take effect.
  72. systemdict wcheck
  73.  { /protected 1500 dict def }
  74.  { /protected null def }
  75. ifelse        % do first so // will work
  76. systemdict wcheck
  77.  { systemdict begin
  78.      /executeonly
  79.       { dup //protected exch a_executeonly put readonly
  80.       } bind odef
  81.      /noaccess
  82.       { dup //protected exch a_noaccess put readonly
  83.       } bind odef
  84.    end
  85.  }
  86.  { (Warning: you will not be able to convert protected fonts.\n) print
  87.    (If you need to convert a protected font,\n) print
  88.    (please restart Ghostscript with the -dWRITESYSTEMDICT switch.\n) print
  89.    flush
  90.  }
  91. ifelse
  92.  
  93. % ------ Output utilities ------ %
  94.  
  95. % By convention, the output file is named cfile.
  96.  
  97. % Define some utilities for writing the output file.
  98.    /wtstring 100 string def
  99.    /wb {cfile exch write} bind def
  100.    /ws {cfile exch writestring} bind def
  101.    /wl {ws (\n) ws} bind def
  102.    /wt {wtstring cvs ws} bind def
  103.  
  104. % Write a C string.  Some compilers have unreasonably small limits on
  105. % the length of a string literal or the length of a line, so every place
  106. % that uses wcs or wcsl must either believe that the string is short,
  107. % or be prepared to use wcca instead.
  108.    /wbx
  109.      { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
  110.      } bind def
  111.    /wcst [
  112.      /wbx load 31 { dup } repeat
  113.      /wb load 94 { dup } repeat
  114.      /wbx load 128 { dup } repeat
  115.    ] def
  116.    ("\\) { wcst exch { (\\) ws wb } put } forall
  117.    /wcs
  118.     { (") ws { dup wcst exch get exec } forall (") ws
  119.     } bind def
  120.    /wcsl    % Write C string with length
  121.     { ({) ws dup length wt (,) ws wcs (}) ws
  122.     } bind def
  123.    /can_wcs    % Test if can use wcs
  124.     { length max_wcs le
  125.     } bind def
  126. % Write a C string as an array of character values.
  127. % We only need this because of line and literal length limitations.
  128.    /wcca
  129.     { 100 ({) 3 -1 roll
  130.        { exch ws
  131.          exch dup 19 ge { () wl pop 0 } if 1 add
  132.      exch wt (,)
  133.        } forall
  134.       pop pop (}) ws
  135.     } bind def
  136.  
  137. % Write object protection attributes.
  138.    /wpa
  139.     { dup xcheck { (a_executable+) ws } if
  140.       getpa prot_names exch get ws
  141.     } bind def
  142.    /wva
  143.     { getva prot_names exch get ws
  144.     } bind def
  145.  
  146. % Write a named object.  Return true if this was possible.
  147. % Legal types are: boolean, integer, name, real, string,
  148. % array of (integer, integer+real, null+string).
  149. % Dictionaries are handled specially.  Other types are ignored.
  150.    /isall    % array proc -> bool
  151.     { true 3 -1 roll
  152.        { 2 index exec not { pop false exit } if }
  153.       forall exch pop
  154.     } bind def
  155.    /wta        % name wproc array ->
  156.     { dup 4 1 roll
  157.       dup length 0 eq { pop {0} } if
  158.       2 index wt (_array[] = {\n) exch
  159.        { exch ws 1 index exec
  160.          (\)) ws (,\n)
  161.        }
  162.       forall pop pop (\n};\nstatic ref_(ref *) ) ws
  163.       dup wt ( = array_v\() ws 1 index length wt (, ) ws
  164.       wt (_array, ) ws wpa (\);) wl
  165.     } bind def
  166.    /woatt [
  167.     % Integers
  168.      { { type /integertype eq }
  169.        { (static ref_(long) ) ws { (integer_v\() ws wt } exch wta true }
  170.      }
  171.     % Integers + reals
  172.      { { type dup /integertype eq exch /realtype eq or }
  173.        { (static ref_(float) ) ws { (real_v\() ws wt } exch wta true }
  174.      }
  175.     % Strings + nulls
  176.     /a_name null def        % predefine so we can use store, not def
  177.     /a_body null def
  178.      { { type dup /nulltype eq exch /stringtype eq or }
  179.        {    % Write the strings first with wcca
  180.          /a_body exch store
  181.      /a_name exch store
  182.      [ 0 1 a_body length 1 sub
  183.       { dup a_body exch get dup null eq
  184.          { exch pop }
  185.          { exch wtstring cvs (_) concatstrings
  186.            a_name wtstring cvs exch concatstrings
  187.            (static char ) ws dup ws ([] = ) ws exch wcca (;) wl
  188.          }
  189.         ifelse
  190.       } for
  191.      ]
  192.          % Make the protections match
  193.      prot_opers a_body getpa get exec
  194.      a_name exch
  195.         % Now write the array itself
  196.          (static ref_(char *) ) ws
  197.           { dup null eq
  198.          { pop (null_v\() ws }
  199.          { (string_v\(sizeof\() ws dup ws (\),) ws ws }
  200.         ifelse
  201.       }
  202.      exch wta true
  203.        }
  204.      }
  205.     % Default
  206.      { { pop true }
  207.        { pop pop false }
  208.      }
  209.    ] def
  210.    /wnstring 128 string def
  211.    /wott 7 dict dup begin
  212.       /arraytype
  213.        { woatt
  214.           { aload pop 2 index 2 index isall
  215.          { exch pop exec exit }
  216.          { pop pop }
  217.         ifelse
  218.       }
  219.      forall
  220.        } bind def
  221.       /booleantype
  222.        { exch (static ref_(ushort) ) ws wt ( = boolean_v\() ws
  223.          { (1) } { (0) } ifelse ws (\);) wl true
  224.        } bind def
  225.       /dicttype
  226.        { pop alldictdict exch known
  227.        } bind def
  228.       /integertype
  229.        { exch (static ref_(long) ) ws wt ( = integer_v\() ws
  230.          wt (\);) wl true
  231.        } bind def
  232.       /nametype
  233.        { exch (static ref_(char *) ) ws wt ( = name_v\() ws
  234.          wnstring cvs dup length wt (,) ws wcs    % OK, names are short
  235.      (\);) wl true
  236.        } bind def
  237.       /realtype
  238.        { exch (static ref_(float) ) ws wt ( = real_v\() ws
  239.          wt (\);) wl true
  240.        } bind def
  241.       /stringtype
  242.        { dup can_wcs
  243.           { exch (static ref_(char *) ) ws wt ( = string_v\() ws
  244.         dup length wt (,) ws wcs (\);) wl true
  245.       }
  246.           { (static char ) ws 1 index wt (_[] = ) ws wcca (;) wl
  247.         dup dup (static ref_(char *) ) ws wt
  248.         ( = string_v\(sizeof\() ws wt (_\),) ws wt (_\);) wl true
  249.       }
  250.      ifelse
  251.        } bind def
  252.    end def
  253.    /wo        % name obj -> OK
  254.     { dup type wott exch known
  255.        { dup type wott exch get exec }
  256.        { pop pop false }
  257.       ifelse
  258.     } bind def
  259.  
  260. % Write a named dictionary.  We assume the ref is already declared.
  261.    /wd        % name dict
  262.     { ({) wl dup [ exch
  263.        { 2 copy wo
  264.           { pop }
  265.       { pop pop }
  266.      ifelse
  267.        } forall
  268.       ]
  269.       dup (static char _ds *str_keys_[] = {) wl
  270.        { wtstring cvs wcs    % OK, key names are short
  271.          (,) wl
  272.        }
  273.       forall (0\n};) wl
  274.       (static ref _ds *values_[] = {\n) exch
  275.        { exch ws ((ref _ds *)&) ws wt (,\n)
  276.        }
  277.       forall pop (\n};) wl
  278.       (\tstatic cfont_dict_keys keys_ =) wl
  279.       (\t { 0, 0, str_keys_, countof\(str_keys_\) - 1, 1, ) ws
  280.       dup wpa (, ) ws wva ( };) wl
  281.       (\tcode = cfont_ref_dict_create\(&) ws wt
  282.       (, &keys_, values_\);) wl
  283.       (\tif (code < 0) return code;) wl
  284.       (}) wl
  285.     } bind def
  286.  
  287. % Write a character dictionary.
  288. % We save a lot of space by abbreviating keys which appear in
  289. % StandardEncoding or ISOLatin1Encoding.
  290.    /wcd        % namestring createtype dict valuetype writevalueproc ->
  291.     {    % Keys present in StandardEncoding or ISOLatin1Encoding
  292.       2 index
  293.       (static charindex enc_keys_[] = {) wl
  294.       0 exch
  295.        { pop decoding 1 index known
  296.           { decoding exch get ({) ws dup -8 bitshift wt
  297.         (,) ws 255 and wt (}, ) ws
  298.         1 add dup 5 mod 0 eq { (\n) ws } if
  299.       }
  300.       { pop }
  301.      ifelse
  302.        }
  303.       forall pop
  304.       ({0,0}\n};) wl
  305.     % Other keys
  306.       2 index
  307.       (static char _ds *str_keys_[] = {) wl
  308.        { pop decoding 1 index known
  309.           { pop
  310.       }
  311.       { (\t) ws wtstring cvs wcs    % OK, key names are short
  312.         (,) wl
  313.       }
  314.      ifelse
  315.        }
  316.       forall
  317.       (\t0\n};) wl
  318.     % Values, with those corresponding to stdkeys first.
  319.       (static ) ws 1 index ws
  320.       2 index
  321.       ( values_[] = {\n) exch
  322.        { decoding 2 index known
  323.           { exch pop exch ws (\t) ws 1 index exec (,\n) }
  324.       { pop pop }
  325.      ifelse
  326.        }
  327.       forall
  328.       3 index
  329.        { decoding 2 index known
  330.           { pop pop }
  331.       { exch pop exch ws (\t) ws 1 index exec (,\n) }
  332.      ifelse
  333.        }
  334.       forall pop
  335.       (\n};) wl
  336.     % Actual creation code
  337.       (static cfont_dict_keys keys_ = {) wl
  338.       (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
  339.       (\tstr_keys_, countof\(str_keys_\) - 1, 0, ) ws
  340.       pop pop
  341.       dup wpa (, ) ws wva () wl
  342.       (};) wl
  343.       (\tcode = cfont_) ws ws (_dict_create\(&) ws ws (, &keys_, values_\);) wl
  344.       (\tif ( code < 0 ) return code;) wl
  345.     } bind def
  346.  
  347. % ------ The main program ------ %
  348.  
  349. % Construct an inverse dictionary of encodings.
  350. 3 dict begin
  351.  StandardEncoding (StandardEncoding) def
  352.  ISOLatin1Encoding (ISOLatin1Encoding) def
  353.  SymbolEncoding (SymbolEncoding) def
  354. currentdict end /encodingnames exch def
  355.  
  356. % Invert the StandardEncoding and ISOLatin1Encoding vector.
  357. 512 dict begin
  358.   0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } bind for
  359.   0 1 255 { dup StandardEncoding exch get exch def } bind for
  360. currentdict end /decoding exch def
  361.  
  362. /writefont        % cfilename -> [writes the current font]
  363.  { /cfname exch def
  364.    /cfile cfname (w) file def
  365.    /Font currentfont def
  366.    Font /FontName get wtstring cvs
  367.    dup length 1 sub 0 exch 1 exch
  368.     { dup wtstring exch get 45 eq { wtstring exch 95 put } { pop } ifelse
  369.     }
  370.    for (font_) exch concatstrings
  371.    /fontproc exch def
  372.    Font /CharStrings get length dict
  373.    /charmap exch def
  374.  
  375. % Define all the dictionaries we know about.
  376. % wo uses this when writing out dictionaries.
  377.    [ (Font) (FontInfo) (CharStrings) (Private)
  378.      encodingnames Font /Encoding get known not
  379.       { % Make a fake entry for Encoding, for later
  380.         (Encoding)
  381.       }
  382.      if
  383.      Font /Metrics known { (Metrics) } if
  384.    ]
  385.    dup /alldictnames exch def
  386.    dup length 1 sub 1 exch getinterval    % drop Font
  387.    dup length dict begin { dup def } forall
  388.    currentdict end /alldictdict exch def
  389.  
  390. % Write out the boilerplate.
  391.    Font begin
  392.    (/* Copyright (C) 1992 Aladdin Enterprises.  All rights reserved.) wl
  393.    (   Distributed by Free Software Foundation, Inc.) wl
  394.    () wl
  395.    (This file is part of Ghostscript.) wl
  396.    () wl
  397.    (Ghostscript is distributed in the hope that it will be useful, but) wl
  398.    (WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility) wl
  399.    (to anyone for the consequences of using it or for whether it serves any) wl
  400.    (particular purpose or works at all, unless he says so in writing.) wl
  401.    (Refer to the Ghostscript General Public License for full details.) wl
  402.    () wl
  403.    (Everyone is granted permission to copy, modify and redistribute) wl
  404.    (Ghostscript, but only under the conditions described in the Ghostscript) wl
  405.    (General Public License.  A copy of this license is supposed to have been) wl
  406.    (given to you along with Ghostscript so you can know your rights and) wl
  407.    (responsibilities.  It should be in a file named COPYING.  Among other) wl
  408.    (things, the copyright notice and this notice must be preserved on all) wl
  409.    (copies.  */) wl
  410.    () wl
  411.    (/* ) ws cfname ws ( */) wl
  412.    (/* This file was created by the Ghostscript font2c utility. */) wl
  413.    () wl
  414.    FontInfo /Notice known
  415.     { (/* Portions of this file are subject to the following notice: */) wl
  416.       (/****************************************************************) wl
  417.       FontInfo /Notice get wl
  418.       ( ****************************************************************/) wl
  419.       () wl
  420.     } if
  421.    (#include "ghost.h") wl
  422.    (#include "ccfont.h") wl
  423.    (#include "oper.h") wl
  424.    (#include "errors.h") wl
  425.    () wl
  426.  
  427. % Write the operator prologue.
  428.    (static int) wl
  429.    (#ifdef __PROTOTYPES__) wl
  430.    fontproc ws ((os_ptr op)) wl
  431.    (#else) wl
  432.    fontproc ws ((op) os_ptr op;) wl
  433.    (#endif) wl
  434.    ({\tint code;) wl
  435.    alldictnames
  436.     { (\tstatic ref ) ws ws (;) wl }
  437.    forall
  438.  
  439. % Write out the FontInfo.
  440.    (FontInfo) FontInfo wd
  441.  
  442. % Write out the CharStrings.
  443. % We write the strings with wcca first, and save the mapping in a dictionary.
  444.    ({) wl
  445.    0 CharStrings
  446.     { exch pop
  447.       charmap 1 index 3 index put
  448.       (static char cs) ws 1 index wt ([] = ) ws wcca (;) wl
  449.       1 add
  450.     } forall pop
  451.    (CharStrings) (string) CharStrings (charray)
  452.     { ({sizeof\(cs) ws charmap exch get dup wt
  453.       (\),cs) ws wt (}) ws
  454.     } wcd
  455.    (}) wl
  456.  
  457. % Write out the Metrics.
  458.    Font /Metrics known
  459.     { ({) wl
  460.       (Metrics) (num) Metrics (float) { wtstring cvs ws } wcd
  461.       (}) wl
  462.     }
  463.    if
  464.  
  465. % Write out the Private dictionary.
  466.    (Private) Private wd
  467.  
  468. % Write out the Encoding vector, if it isn't standard.
  469.    encodingnames Encoding known not
  470.     { (\t{ static char _ds *str_elts_[] = {\n)
  471.       Encoding
  472.        { exch ws wtstring cvs wcs    % OK, character names are short
  473.          (,\n)
  474.        }
  475.       forall pop (\n};) wl
  476.       (\tcode = cfont_name_array_create\(&Encoding, str_elts_, countof\(str_elts_\)\);) wl
  477.       (\tif (code < 0) return code;) wl
  478.       (}) wl
  479.     }
  480.    if
  481.  
  482. % Write out the main font dictionary.
  483. % If possible, substitute the encoding name for the encoding;
  484. % PostScript code will fix this up.
  485.    Font dup length dict copy
  486.    encodingnames Encoding known
  487.     { dup /Encoding encodingnames Encoding get put
  488.     }
  489.     { % Force it to be treated like a known dictionary
  490.       dup /Encoding 1 dict put
  491.     }
  492.    ifelse
  493.    (Font) exch wd
  494.  
  495. % Finish the procedural initialization code.
  496.    (\tpush(1);) wl
  497.    (\t*op = Font;) wl
  498.    (\treturn 0;) wl
  499.    (}) wl
  500.  
  501. % Write out the operator initialization table.
  502.    (\nop_def ) ws fontproc ws (_op_defs[] = {) wl
  503.    (\t{"0.font_) ws FontName wt (", ) ws fontproc ws (},) wl
  504.    (\top_def_end(0)) wl
  505.    (};) wl
  506.    end
  507.  
  508.    cfile closefile
  509.  
  510.  } bind def
  511.  
  512. % If the program was invoked from the command line, run it now.
  513. [ shellarguments
  514.  { counttomark 2 eq
  515.     { exch cvn
  516.       dup FontDirectory exch known { dup FontDirectory exch undef } if
  517.       findfont setfont
  518.       writefont
  519.     }
  520.     { cleartomark
  521.       (Usage: font2c fontname cfilename.c\n) print
  522.       ( e.g.: font2c Courier cour.c\n) print flush
  523.       mark
  524.     }
  525.    ifelse
  526.  }
  527. if pop
  528.